home *** CD-ROM | disk | FTP | other *** search
/ Compute! Gazette 1989 March / 1989-03.d64 / monthly calendar (.txt) < prev    next >
Commodore BASIC  |  2022-09-20  |  8KB  |  313 lines
  1. 100 rem copyright 1988 compute! publications, inc. - all rights reserved
  2. 110 lc$=chr$(14):re$=chr$(15):gm$=chr$(8):nr=7
  3. 120 dim cm(255)
  4. 130 dimmo$(12),ld(12),da$(60),ms$(50,nr+1),dd$(2,60),l$(20),ml$(18),c(255)
  5. 140 sp$=" ":fori=0to5:sp$=sp$+sp$:next:sp$=left$(sp$,31):ss$=left$(sp$,10)
  6. 150 poke53280,15:poke53281,11
  7. 160 print"[155][147]"
  8. 170 printtab(11)"monthly calendar "
  9. 190 printtab(11)" copyright 1989 "
  10. 200 printtab(7)"compute! publications, inc."
  11. 210 printtab(10)"all rights reserved"
  12. 220 fori=27 to 127:cm(i)=1:cm(i+128)=1:next
  13. 230 i=2
  14. 240 read a:if a=-1 then270
  15. 250 cm(a)=i:i=i+1:goto240
  16. 260 data 17,145,29,157,147,13,19,20,148,95,-1
  17. 270 i=0
  18. 280 read a$
  19. 290 t=asc(left$(a$,1)):c(t)=i+1
  20. 300 a$(i)=chr$(49+i)+" "+chr$(t)+"[146]"+right$(a$,len(a$)-1)
  21. 310 i=i+1:if a$<>"quit" then280
  22. 320 data "new calendar","year and month",memo,"enhance dates",print,save,load
  23. 330 data quit
  24. 340 forh=1to12:readmo$(h),ld(h):nexth
  25. 350 n4=i-1
  26. 360 fori=0 to n4:print:printspc(12) a$(i):next
  27. 370 geta$:if a$="" then370
  28. 380 a2=asc(a$):if c(a2) then a2=c(a2):goto410
  29. 390 v=val(a$):if v>0 and v<=i then a2=v:goto410
  30. 400 goto370
  31. 410 on a2 gosub3070,450,2170,1430,920,2310,2500,2070
  32. 420 print"[147]":goto360
  33. 430 print"[147]":if yr$="" then print"choose year and month first":gosub460:goto430
  34. 440 return
  35. 450 print"[147]"
  36. 460 print"enter calendar year: ";
  37. 470 input t$
  38. 480 if t$="" then return
  39. 490 if val(t$)<100 or val(t$)>9999then goto450
  40. 500 yr$=t$:y=val(yr$)
  41. 510 print"[147]"
  42. 520 print"select month(1-12)"
  43. 530 fori=1to9:printtab(10)"[144]"i"[155]"mo$(i):next
  44. 540 fori=10to12:printtab(9)"[144]"i"[155]"mo$(i):next
  45. 550 input"enter month";nu$
  46. 560 nu=val(nu$):ifnu>=1andnu<=12thenhh=0:goto610
  47. 570 fori=1to12
  48. 580 ifnu$=mo$(i)thennu=i:hh=0:goto610
  49. 590 nexti
  50. 600 goto520
  51. 610 rem calculations
  52. 620 ld(2)=28:gosub2080
  53. 630 a=(y/100):b=int(y/100):c=a-b
  54. 640 ifc=0then680
  55. 650 a=(y/4):b=int(y/4):c=a-b
  56. 660 ifc=0thenad=1:goto710
  57. 670 ad=0:goto710
  58. 680 a=(y/400):b=int(y/400):c=a-b
  59. 690 ifc=0thenad=1:goto710
  60. 700 ad=0:goto710
  61. 710 a=int(y/4):b=int(y/400):c=int(y/100):d=a+b-c
  62. 720 e=(y+d)/7:f=int((y+d)/7):g=(e-f)*7:sd=int(g):h=g-sd
  63. 730 ifh>.9thensd=sd+1
  64. 740 sd=sd-ad
  65. 750 ifsd<0thensd=sd+7
  66. 760 onnugosub1310,1320,1330,1340,1350,1360,1370,1380,1390,1400,1410,1420
  67. 770 ifds>6thends=ds-7
  68. 780 ifds<0thends=ds+7
  69. 790 d=0:ifflag=1thenflag=0:goto810
  70. 800 ifhh<>0thenreturn
  71. 810 fori=1to50
  72. 820 ifi-ds<=0thenda$(i)="":goto850
  73. 830 ifi-ds>ld(nu)thenda$(i)="":goto850
  74. 840 da$(i)=str$(i-ds):da$(i)=right$(da$(i),len(da$(i))-1)
  75. 850 nexti
  76. 860 ifds=0andld(nu)=28thenr=4:goto890
  77. 870 ifda$(36)=""thenr=5:goto890
  78. 880 r=6
  79. 890 hd$=mo$(nu)+"      "+yr$
  80. 900 cs=int((40-len(hd$))/2)
  81. 910 return
  82. 920 gosub430:if a2<>5 then950
  83. 930 t$="include memo bar in print out":gosub3030
  84. 940 mb$="n":if q then mb$="y"
  85. 950 print"[147]make sure printer is on..."
  86. 960 print"_ for menu, any other key to print"
  87. 970 getch$:ifch$=""then970
  88. 980 if ch$="_" then return
  89. 990 gosub2100:close5:open5,4,6:open4,4:print#4,lc$;tab(cs)hd$;re$;
  90. 1000 print#4:print#5,chr$(20)
  91. 1010 print#4,"[176][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][178][192][192][192][192][192][192]";
  92. 1020 print#4,"[192][192][192][192][178][192][192][192][192][192][192][192][192][192][192][174]";gm$
  93. 1030 print#4,re$;"[221]sunday    [221]monday    [221]tuesday   [221]wednesday [221]thursday  ";
  94. 1040 print#4,"[221]friday    [221]saturday  [221]";gm$
  95. 1050 gosub1280
  96. 1060 fori=1tor
  97. 1070 gosub1280
  98. 1080 print#4,re$;
  99. 1090 forz=1to7:tb=(z)*11:tb$=str$(tb):tb$=right$(tb$,2)
  100. 1100 print#4,"[221]";lc$;da$(d+z);re$;chr$(16)+tb$;
  101. 1110 next z
  102. 1120 print#4,chr$(16)+"77";"[221]";gm$
  103. 1130 print#4,re$;:d7=d-ds
  104. 1140 fortt=1tonr
  105. 1150 fort=1to7:tb=(t)*11:tb$=str$(tb):tb$=right$(tb$,2)
  106. 1160 d8=d7+t:if d8<0 or d8>31 then t$=ss$:goto1180
  107. 1170 t$=ms$(d7+t,tt-1)
  108. 1180 print#4,"[221]";t$;chr$(16)+tb$;
  109. 1190 next t
  110. 1200 print#4,chr$(16)+"77";"[221]";gm$
  111. 1210 print#4,re$;
  112. 1220 next tt
  113. 1230 d=d+7:nexti
  114. 1240 ifmb$="n"then2120
  115. 1250 print#4,re$;"[171][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192]";
  116. 1260 print#4,"[192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][179]"gm$
  117. 1270 close4,4:goto1700
  118. 1280 print#4,re$;"[171][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][219][192][192][192][192]";
  119. 1290 print#4,"[192][192][192][192][192][192][219][192][192][192][192][192][192][192][192][192][192][179]";gm$
  120. 1300 return
  121. 1310 ds=sd:return
  122. 1320 ds=sd+3:ld(nu)=ld(nu)+ad:return
  123. 1330 ds=sd+3+ad:return
  124. 1340 ds=sd-1+ad:return
  125. 1350 ds=sd+1+ad:return
  126. 1360 ds=sd+4+ad:return
  127. 1370 ds=sd-1+ad:return
  128. 1380 ds=sd+2+ad:return
  129. 1390 ds=sd+5+ad:return
  130. 1400 ds=sd+ad:return
  131. 1410 ds=sd+3+ad:return
  132. 1420 ds=sd+5+ad:return
  133. 1430 rem enhance dates
  134. 1440 print"[147]":if yr$="" then print"choose year and month first":gosub460
  135. 1450 du=0:print"[147][155]";
  136. 1460 printhd$
  137. 1470 print"sun  mon  tue  wed  thu  fri  sat"
  138. 1480 foru=0to5
  139. 1490 foruu=1to7
  140. 1500 do=(uu-1)*5:printtab(do)da$(uu+du);
  141. 1510 t=u*7+uu
  142. 1520 nextuu
  143. 1530 print"":du=du+7
  144. 1540 nextu
  145. 1550 print" input 'q' when finished enhancing dates":input "enter date";md$
  146. 1560 if md$="q" or md$="[209]" then return
  147. 1570 md=val(md$)
  148. 1580 ifmd<1 or md>ld(nu)thenprint"[145][145][145][145]":goto1550
  149. 1590 pr$="[147]enter message for[144] "+mo$(nu)+ " "+str$(md)+"[155]"
  150. 1600 b$="":h=nr:w=10
  151. 1610 for i=0 to nr
  152. 1620 t$=ms$(md,i):if len(t$)<>w then t$=ss$
  153. 1630 b$=b$+t$
  154. 1640 next
  155. 1650 gosub2630:j=0
  156. 1660 for i=1 to h*w+1 step  w
  157. 1670 ms$(md,j)=mid$(b$,i,w):j=j+1
  158. 1680 next
  159. 1690 goto1450
  160. 1700 ifnu=1thenn1=12:n2=2:y(1)=y-1:y(2)=y:goto1730
  161. 1710 ifnu=12thenn1=11:n2=1:y(1)=y:y(2)=y+1:goto1730
  162. 1720 n1=nu-1:n2=nu+1:y(1)=y:y(2)=y
  163. 1730 nu=n1:y=y(1):hh=1:ch=1:d=0
  164. 1740 gosub620
  165. 1750 d=0
  166. 1760 fori=1to50
  167. 1770 ifi-ds<=0thendd$(hh,i)="   ":goto1810
  168. 1780 ifi-ds>ld(nu)thendd$(hh,i)="   ":goto1810
  169. 1790 ifi-ds<10thendd$(hh,i)=" "+str$(i-ds):goto1810
  170. 1800 dd$(hh,i)=str$(i-ds)
  171. 1810 nexti:hd$(hh)=mo$(nu)+"   "+str$(y(hh)):cs(hh)=int((22-len(hd$(hh)))/2)
  172. 1820 ifhh=2thencs(hh)=cs(hh)+56
  173. 1830 cs$(hh)=str$(cs(hh)):cs$(hh)=right$(cs$(hh),2)
  174. 1840 ifhh=1thenhh=2:nu=n2:y=y(2):gosub620:goto1750
  175. 1850 l$(1)="[221]"+chr$(16)+"22[221]"+chr$(16)+"55[221]"+chr$(16)+"77[221]"
  176. 1860 l$(2)="[221]"+chr$(16)+cs$(1)+hd$(1)+chr$(16)+"22[221]"+lc$+"     memos"+re$
  177. 1870 l$(2)=l$(2)+chr$(16)+"55[221]"+chr$(16)+cs$(2)+hd$(2)+chr$(16)+"77[221]"
  178. 1880 l$(3)=l$(1)
  179. 1890 l$(4)="[221] su mo tu we th fr sa[221]"
  180. 1900 l$(4)=l$(4)+chr$(16)+"55[221] su mo tu we th fr sa[221]"
  181. 1910 l$(5)=l$(1):j=6
  182. 1920 fori=6to18step2
  183. 1930 l$(i)="[221]"
  184. 1940 forii=1to7
  185. 1950 l$(i)=l$(i)+dd$(1,ii+d)
  186. 1960 nextii
  187. 1970 t$=ml$(j):if len(t$)<31 then t$=sp$:ml$(j)=sp$
  188. 1980 l$(i)=l$(i)+chr$(16)+"22[221] "+t$+"[221]":j=j+1
  189. 1990 forii=1to7:l$(i)=l$(i)+dd$(2,d+ii):nextii
  190. 2000 l$(i)=l$(i)+chr$(16)+"77[221]"
  191. 2010 l$(i+1)=l$(1)
  192. 2020 d=d+7:nexti
  193. 2030 l$(18)="[173][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192]"
  194. 2040 l$(18)=l$(18)+"[192][192][192][192][192][177][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][192][189]"
  195. 2050 gosub2100:open4,4:fori=1to18:print#4,re$;l$(i);gm$:nexti
  196. 2060 close4,4:y=val(yr$):nu=val(nu$):gosub620:return
  197. 2070 poke 53280,14:poke53281,6:print"[147][154]";:clr:end
  198. 2080 print"[147][144]calculating...[155]"
  199. 2090 return
  200. 2100 print"[147]printing[146]...(press run/stop to abort)[155]"
  201. 2110 return
  202. 2120 print#4,re$;"[173][192][192][192][192][192][192][